HPAVC/HPAVC CD-ROM.iso/pc/ML_BME1.ZIP/DISTORT/DIST1_V1.PAS

Pascal/Delphi Source File | 1996-12-21 | 3.9 KB | 194 lines

{
 4-waves distortion of a 320x200 bitmap
 by Maple Leaf, 1996
 ------------------------------------------------------------------------
 "version" 1 - using Pascal's floating point - terribly slow!

 Do whatever you want with this code, but if you intend to use any parts of
 it, please credit me - say "hello Maple Leaf" or something, and this should
 be quite enough...
}
uses alloc, dosio, bitmap;

var vScr, Temp : word;
    Img : pointer;
    Pal : array[byte] of record r,g,b:byte end;

    Wave1, Wave2 : array [0..199] of integer;  { Left/Right }
    Wave3, Wave4 : array [0..319] of integer;  { Up/Down }

procedure InitVideo;near;assembler;
asm
  mov ax,13h
  int 10h  { init video mode }
  mov dx,3c8h
  mov al,0
  out dx,al
  inc dx
  mov cx,768
  mov si,offset pal
  rep outsb { set palette }
end;

procedure vWait;near;assembler;
asm
    mov dx,3DAh
@1: in al,dx
    test al,8
    jne @1
@2: in al,dx
    test al,8
    je @2
end;

procedure ShowVScreen;near;assembler;
asm
  push ds
  push es
  mov cx,16000
  mov ax,0A000h
  mov es,ax
  mov di,0
  mov si,di
  mov ds,VScr
  cld
  db 66h; rep movsw
  pop es
  pop ds
end;

procedure freeAll;
begin
  free(img);
  hfree(vScr);
  hfree(Temp);
end;

procedure InitData;
begin
  vScr:=halloc(64000);
  Temp:=halloc(64000);
  Img:=LoadPCX(paramstr(1),@pal);
  if (Img=nil) or (vScr=0) or (Temp=0) then begin
    freeAll;
    asm mov ax,3; int 10h end;
    writeln('Not enough memory');
    halt
  end;
end;

var ang : word;

procedure UpdateWaves;  { update the four waves (left/right/up/down) }
const MaxAmpl = 40;
      MA = MaxAmpl div 2;
var k:word;
begin
  inc(ang,5);
  for k:=0 to 199 do begin
    Wave1[k]:=trunc(MA+MA*sin(2*(k+ang)*pi/180)*cos(8*(k+ang)*pi/180));{}
    Wave2[k]:=trunc(MA+MA*cos(8*(k+ang)*pi/180)*sin(4*(k+ang)*pi/180));{}
  end;
  for k:=0 to 319 do begin
    Wave3[k]:=trunc(MA+MA*sin(8*(k+ang)*pi/180)*sin(2*(k+ang)*pi/180));{}
    Wave4[k]:=trunc(MA+MA*cos(1*(k+ang)*pi/180)*cos(8*(k+ang)*pi/180));{}
  end;
end;

procedure DistortLine(k:word);
var XStart, XEnd, NewXSize, sOffs, dOffs, j : word;
    xAddF,xx : real;
    byt:byte;
procedure stosb;
begin
  mem[temp:dOffs]:=byt; {!!!!!}
  inc(dOffs);
end;
begin
  XStart:=Wave1[k];
  XEnd:=319-Wave2[k];
  NewXSize:=XEnd-XStart+1;
  xAddF:=320/NewXSize;
  xx:=0;
  sOffs:=k*320;
  dOffs:=sOffs;
  { do the left black area }
  byt:=0;
  for j:=1 to xStart do stosb;
  { distort the line }
  for j:=1 to NewXSize do begin
    byt:=mem[seg(Img^):sOffs+round(xx)];  { !!! use ROUND, not TRUNC !!! }
    stosb;
    xx:=xx+xAddF;
  end;
  { do the right black area }
  byt:=0;
  for k:=1 to (319-xEnd) do stosb;
end;

procedure HoriDistort;
var k:word;
begin
  for k:=0 to 199 do DistortLine(k);
end;

procedure DistortCol(k:word);
var yStart, yEnd, NewYSize, j : word;
    yAddF, yy : real;
    byt:byte;
    dOffs, sOffs : word;
procedure stosb;
begin
  mem[vscr:dOffs]:=byt; {!!!!!}
  inc(dOffs,320);
end;
begin
  yStart:=Wave3[k];
  yEnd:=199-Wave4[k];
  NewYSize:=yEnd-yStart+1;
  yAddF:=200/NewYSize;
  yy:=0;
  dOffs:=k;
  { do the left black area }
  byt:=0;
  for j:=1 to yStart do stosb;
  { distort the line }
  for j:=1 to NewYSize do begin
    byt:=mem[temp:k+round(yy)*320];  { !!! use ROUND, not TRUNC !!! }
    stosb;
    yy:=yy+yAddF;
  end;
  { do the right black area }
  byt:=0;
  for k:=1 to (199-yEnd) do stosb;
end;

procedure VertDistort;
var k:word;
begin
  for k:=0 to 319 do DistortCol(k);
end;

procedure DoIt;
begin
  repeat
    UpdateWaves;
    HoriDistort;
    VertDistort;
    vWait;
    ShowVScreen;
  until port[$60]=1;
end;

begin
  if paramcount=0 then begin
    writeln('Parameter expected (FileName.PCX)');
    halt
  end;
  InitData;
  InitVideo;
  DoIt;
  asm mov ax,3; int 10h end;
  freeAll;
end.